Setup
pacman::p_load("tidyverse", "here", "glue", "colorspace", "gsheet", "labelled", "sf", "pdftools")
Daten
Tile Map
## csv mit nur Wahlkreisen, für Tile Map
#write_csv(dat_erst_winneronly_dw %>% dplyr::select(Wahlkreisname), here::here("data", "wk.csv"))
## Grid Preparation für Labels und Bundesländer
grid <-
read_csv(here::here("data", "wk_grid_raw.csv")) %>%
mutate(
id = str_sub(Wahlkreisname, 1, 3),
id_num = as.numeric(id),
wk = str_sub(Wahlkreisname, 5, nchar(Wahlkreisname)),
land = case_when(
id_num %in% 1:11 ~ "Schleswig-Holstein",
id_num %in% 12:17 ~ "Mecklenburg-Vorpommern",
id_num %in% 18:23 ~ "Hamburg",
id_num %in% 24:53 ~ "Niedersachsen",
id_num %in% 54:55 ~ "Bremen",
id_num %in% 56:65 ~ "Brandenburg",
id_num %in% 66:74 ~ "Sachsen-Anhalt",
id_num %in% 75:86 ~ "Berlin",
id_num %in% 87:150 ~ "Nordrhein-Westfalen",
id_num %in% 151:166 ~ "Sachsen",
id_num %in% 167:188 ~ "Hessen",
id_num %in% 189:196 ~ "Thüringen",
id_num %in% 197:211 ~ "Rheinland-Pfalz",
id_num %in% 212:257 ~ "Bayern",
id_num %in% 258:295 ~ "Baden-Württemberg",
id_num %in% 296:299 ~ "Saarland"
)
)
-- Column specification ----------------------------------------------
cols(
Wahlkreisname = col_character(),
row = col_double(),
col = col_double()
)write_csv(grid, here::here("data", "de_constituencies_grid.csv"))
grid <- read_csv(here::here("data", "de_constituencies_grid.csv"))
-- Column specification ----------------------------------------------
cols(
Wahlkreisname = col_character(),
row = col_double(),
col = col_double(),
id = col_character(),
id_num = col_double(),
wk = col_character(),
land = col_character()
)Vorhersage der Direktmandatsgewinner*innen 2021
Source: Kayser, Leininger, Murr & Stötzer (2021) Citizens’ Forecast for the 2021 German National Election https://aleininger.eu/citizens_forecast2021/
sheet_url <- "https://docs.google.com/spreadsheets/d/1xOg9kNRMfmUXoJAYNp7R93UHfPlVus-2VV-i-Rdx1Uc/edit#gid=0"
dat_erst <- gsheet2tbl(sheet_url)
#dat_erst <- read_csv(here::here("data", "Buerger_innenvorhersage 2021 - Prognose.csv"))
#' t-Test auf Basis von Mittelwert und Standardabweichung
t_test_from_summary <- function(m1, m2, sd1, sd2, n1, n2, ...) {
group1 <- scale(1:n1)*sd1 + m1
group2 <- scale(1:n2)*sd2 + m2
t.test(group1, group2, ...)
}
dat_erst_ttest <- dat_erst %>%
mutate(Stimmenanteil_Mean = ifelse(Stimmenanteil_Mean > 1000,
Stimmenanteil_Mean / 1000,
Stimmenanteil_Mean)) %>%
group_by(wkr) %>%
slice_max(order_by = Stimmenanteil_Mean, n = 2, with_ties = FALSE) %>%
mutate(rank = rank(-Stimmenanteil_Mean, ties.method = "first")) %>%
ungroup() %>%
select(wkr, rank, Stimmenanteil_Mean, Stimmenanteil_SD, obs) %>%
pivot_wider(id_cols = wkr,
names_from = "rank",
values_from = c("Stimmenanteil_Mean", "Stimmenanteil_SD", "obs")) %>%
mutate(t_test = pmap(list(m1 = Stimmenanteil_Mean_1, m2 = Stimmenanteil_Mean_2,
sd1 = Stimmenanteil_SD_1, sd2 = Stimmenanteil_SD_2,
n1 = obs_1, n2 = obs_2, alternative = "greater"),
t_test_from_summary),
t = map_dbl(t_test, "statistic"),
p_value = map_dbl(t_test, "p.value"))
dat_erst_winneronly_dw <-
dat_erst %>%
group_by(wkr) %>%
dplyr::select(wkr, Wahlkreisname, party, kandidate_name, obs, Gewinner_share) %>%
mutate(Gewinner_share = ifelse(Gewinner_share > 100, Gewinner_share / 1000, Gewinner_share),
rank = rank(Gewinner_share, ties.method = "first"),
name = to_character(wkr),
Gewinner_share = round(Gewinner_share*100)) %>%
filter(rank > 5) %>%
mutate(party = as.character(party)) %>%
unite(val, party, Gewinner_share, kandidate_name) %>%
spread(rank,val) %>%
separate("7",into = c("first-place-party", "first-place-votes", "winner"),"_") %>%
separate("6",into = c("second-place-party", "second-place-votes", "second"),"_") %>%
mutate(outcome = ifelse(`first-place-votes` == `second-place-votes`, 'Kopf-an-Kopf', `first-place-party`)) %>%
relocate("outcome", "first-place-party", "first-place-votes", "winner", .before = "second-place-party") %>%
ungroup() %>%
# add t-test statistic
inner_join(dat_erst_ttest, by = "wkr")
Kombinierte Datensätze
dat_winneronly_grid <-
dat_erst_winneronly_dw %>%
left_join(grid) %>%
mutate(
outcome_agg = ifelse(outcome %in% c("CDU", "CSU"), "CDU/CSU", outcome),
diff = as.numeric(`first-place-votes`) - as.numeric(`second-place-votes`),
outcome_agg = factor(outcome_agg, levels = c("CDU/CSU", "SPD", "Grüne", "Linke", "AfD", "Kopf-an-Kopf"))
)
Joining, by = "Wahlkreisname"Visualisierungen
Setup
theme_set(theme_void(base_size = 16, base_family = "Editorial New")) #Editorial New, Noto Serif
theme_update(legend.margin = margin(0, 0, 0, 25),
legend.text = element_text(margin = margin(5, 0, 5, 0)),
plot.title = element_text(hjust = .5, face = "bold",
lineheight = 1.1, margin = margin(t = 10, b = 20)),
plot.subtitle = element_text(hjust = .5, color = "grey40", size = 15,
margin = margin(t = -8, b = 18)),
plot.title.position = "plot",
plot.caption = element_text(hjust = 0, color = "grey40",
lineheight = 1.3,
size = 9, margin = margin(20, 0, 5, 0)),
plot.caption.position = "plot",
plot.margin = margin(10, 0, 10, 0))
# Party colors
party_colors <- c("CDU/CSU" = "grey9",
#"CSU" = "grey18",
"SPD" = "#ca0002", ## "#E3000F", a bit darker now to make it work with CVD
"Grüne" = rgb(100, 161, 45, maxColorValue = 255),
#"FDP" = darken("#ffed00", 0.1),
"Linke" = "purple",
"AfD" = rgb(0, 158, 224, maxColorValue = 255))
caption_de <- "Grafik: Cédric Scherer & Ansgar Wolsing\nDaten: Kayser, Leininger, Murr & Stötzer (2021) Citizens’ Forecast for the 2021 German National Election (aleininger.eu/citizens_forecast2021)\nDie Karte basiert auf einer Befragung einer nicht-repräsentativen Stichprobe von Bürger*innen in allen 299 Wahlkreisen zu den Erfolgsaussichten des*der Kandidierenden*in."
title_de <- "Bürger*innenvorhersage der Direktmandatsgewinner*innen\nin den Wahlkreisen zur Bundestagswahl 2021"
caption_en <- "Graphic: Cédric Scherer & Ansgar Wolsing\nData: Kayser, Leininger, Murr & Stötzer (2021) Citizens’ Forecast for the 2021 German National Election (aleininger.eu/citizens_forecast2021)\nThe map is based on a survey of a non-representative sample of citizens in all 299 Bundestag constituencies on the candidates' chances of success."
title_en <- "Citizens’ Forecast of Direct Mandate Winners in\nthe Constituencies for the 2021 Federal Election"
parties_en <- c("CDU/CSU", "SPD", "The Greens", "The Left", "AFD", "Too close to call")
Bundesländer
set.seed(1234567890)
pal <- sample(ggsci::pal_simpsons()(16))
g <-
ggplot(grid, aes(col, row, color = land, fill = land)) +
geom_tile(size = 3, color = "#212121") +
geom_tile(size = .01) +
coord_fixed() +
scale_x_continuous(expand = c(.01, .01), limits = c(-.5, max(grid$col) + .5)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = pal, name = NULL) +
scale_fill_manual(values = pal, name = NULL) +
theme(plot.margin = margin(15, 10, 15, 0))
## Deutsche Version
g + labs(title = "Tile Grid Karte der Wahlkreise Deutschland", caption = "Grafik: Cédric Scherer & Ansgar Wolsing")
ggsave(here::here("plots", "grid_laender_de.pdf"), width = 10, height = 10, device = cairo_pdf)
## Englische Version
g + labs(title = "Tile Grid Map of Germany's Constituencies", caption = "Design: Cédric Scherer & Ansgar Wolsing")
ggsave(here::here("plots", "grid_laender_en.pdf"), width = 10, height = 10, device = cairo_pdf)
Grid Tile Map
g <- ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(aes(color = outcome_agg), size = 12, shape = 15) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "grid_map_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
ggsave(here::here("plots", "grid_map_en.pdf"), width = 10, height = 13, device = cairo_pdf)
Variante mit gedämpfteren Farben für die Füllung der Punkte
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg),
size = 12, shape = 22, stroke = 2, alpha = .5, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 12, shape = 22, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "grid_map_de_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "grid_map_en_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
Bubble Map
g <- ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(aes(color = outcome_agg), size = 10) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "bubble_map_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_en.pdf"), width = 10, height = 13, device = cairo_pdf)
Variante mit gedämpfteren Farben für die Füllung der Punkte
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg),
size = 10, shape = 21, stroke = 2, alpha = .5, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 10, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "bubble_map_de_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_en_v2.pdf"), width = 10, height = 13, device = cairo_pdf)
Grid Map inkl. Vorsprung als Farbintensität
Vorsprung in Prozentpunkten
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 12, shape = 22, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 12, shape = 22, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "grid_map_diff_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.") +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "grid_map_diff_en.pdf"), width = 10, height = 13, device = cairo_pdf)
Bubble Map inkl. Vorsprung als Farbintensität
Vorsprung in Prozentpunkten
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = caption_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.") +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_diff_en.pdf"), width = 10, height = 13, device = cairo_pdf)
Vorsprung als t-Statistik
g <-
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg,
# alpha = diff
alpha = t # Ergebnis t-Test (oder p-value stattdessen?)
),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25))
## Deutsche Version
g + labs(title = title_de, caption = glue("{caption_de}\nDie Vorhersage der Mandatsgewinner basiert auf einem t-Test auf Basis von Mittelwert und Standardabweichung."),
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_t_test_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en, caption = glue("{caption_en}\nThe prediction of mandate winners is based on a t-test based on mean and standard deviation."),
subtitle = "The more intense the coloring, the greater the predicted lead.") +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "bubble_map_t_test_en.pdf"), width = 10, height = 13, device = cairo_pdf)
Bubble Map inkl. Grenzen der Bundesländer (trial)
Leider nicht so schön und sinnvoll wie erhofft.
ggplot(dat_winneronly_grid, aes(col, row)) +
ggforce::geom_mark_hull(
aes(group = land),
color = "white",
expand = unit(0, "mm")
) +
geom_point(aes(color = outcome_agg), size = 7) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL) +
guides(color = guide_legend(override.aes = list(size = 6))) +
theme(legend.position = c(.87, .25),
plot.background = element_rect(color = "grey67", fill = "grey67")) +
labs(title = title_de, caption = caption_de)
ggsave(here::here("plots", "bubble_map_states.pdf"), width = 10, height = 13, device = cairo_pdf)
Bubble Map mit verschiedenen Punktgrößen für Bundesländer (trial)
Weder effektiv noch schön.
# Größenkategorien für Bundesländer
bland_group_mapping <- c(
"Schleswig-Holstein" = "A",
"Mecklenburg-Vorpommern" = "B",
"Hamburg" = "D",
"Niedersachsen" = "C",
"Bremen" = "E",
"Brandenburg" = "A",
"Sachsen-Anhalt" = "D",
"Berlin" = "A",
"Nordrhein-Westfalen" = "D",
"Sachsen" = "A",
"Hessen" = "E",
"Thüringen" = "B",
"Rheinland-Pfalz" = "A",
"Bayern" = "D",
"Baden-Württemberg" = "B",
"Saarland" = "A"
)
dat_winneronly_grid %>%
mutate(mark_group = bland_group_mapping[land],
mark_shape = case_when(
mark_group == "A" ~ 21,
mark_group == "B" ~ 22,
mark_group == "C" ~ 23,
mark_group == "D" ~ 24,
mark_group == "E" ~ 25,
)) %>%
ggplot(aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff, size = mark_group),
# size = 9,
shape = 21,
stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg, size = mark_group),
# size = 9,
shape = 21,
stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
scale_size_discrete(range = c(7, 11)) +
# scale_shape_identity() +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9)),
size = "none") +
theme(legend.position = c(.87, .25)) +
labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_bland_mark.pdf"), width = 10, height = 13, device = cairo_pdf)
Bubble Map inkl. Vorsprung als Farbintensität - mit Städten zur Orientierung
constituencies_to_highlight <- c(
18, # Hamburg-Mitte
75, # Berlin-Mitte
93, # Köln I
220 # München-West/Mitte
)
df_constituencies_highlight <- dat_winneronly_grid %>%
filter(wkr %in% constituencies_to_highlight) %>%
mutate(name_short = str_extract(Wahlkreisname, "[a-zA-ZäöüÄÖÜ]+")) %>%
select(name_short, name, col, row)
Städtenamen als Overlay
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
geom_label(data = df_constituencies_highlight,
aes(label = name_short),
col = "grey99",
fill = "grey10", alpha = 0.4, family = "Roboto",
label.size = 0,
fontface = "bold", size = 6,
hjust = 0.5) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25)) +
labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_location_highlights.pdf"), width = 10, height = 13, device = cairo_pdf)
Städtenamen als Labels
labels <- dat_winneronly_grid %>%
filter(str_detect(wk, "München|Köln") | land %in% c("Berlin", "Hamburg")) %>%
filter(wk != "München-Land") %>%
mutate(label = case_when(
str_detect(wk, "München") ~ "München",
str_detect(wk, "Köln") ~ "Köln",
TRUE ~ land
))
ggplot(dat_winneronly_grid, aes(col, row)) +
geom_tile(
data = labels,
fill = "grey60", color = "grey60"
) +
geom_point(
fill = "white", size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(fill = outcome_agg, alpha = diff),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
# ggforce::geom_mark_hull(
# data = labels,
# aes(group = label),
# concavity = 0
# ) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 6, alpha = .9))) +
theme(legend.position = c(.87, .25)) +
labs(title = title_de, caption = caption_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.")
ggsave(here::here("plots", "bubble_map_diff_location_highlights_ggforce.pdf"), width = 10, height = 13, device = cairo_pdf)
Interaktive Version via {ggiraph}
library(ggiraph)
g_interactive <- dat_winneronly_grid %>%
mutate(label = str_wrap(glue::glue("{Wahlkreisname} ({land})<br><br>Vorsprung:<br>{outcome} {diff}%"), 50)) %>%
ggplot(aes(col, row)) +
geom_point_interactive(
aes(fill = outcome_agg, alpha = diff, tooltip = label, data_id = label),
size = 9, shape = 21, stroke = 2, color = "transparent"
) +
geom_point(
aes(color = outcome_agg),
size = 9, shape = 21, stroke = 2, fill = "transparent"
) +
coord_fixed() +
scale_x_continuous(limits = c(-.5, max(grid$col) + 2)) +
scale_y_reverse(expand = c(.03, .03)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(color = guide_legend(override.aes = list(size = 6))) +
labs(title = title_de, caption = caption_de)
tooltip_css <- "background-color:#515151;color:white;font-family:Roboto;padding:10px;border-radius:5px;"
girafe(ggobj = g_interactive,
width_svg = 12, height_svg = 12,
options = list(
opts_sizing(rescale = FALSE),
opts_tooltip(offx = 50, css = tooltip_css)
))
#ggsave(here::here("plots", "bubble_map_states.pdf"), width = 10, height = 13, device = cairo_pdf)
Hexagon Tiles
## READ GEOMETRY ==============================================
#' https://pitchinteractiveinc.github.io/tilegrams/
#' Download geometry "Germany - Constituencies" as TopoJSON
#' and place it in the data directory
filepath_topo <- here("data", "tiles.topo.json")
wk_topo <- geojsonio::topojson_read(filepath_topo)
Registered S3 method overwritten by 'geojsonsf':
method from
print.geojson geojsonwk_topo <- wk_topo %>% mutate(id = as.numeric(id))
# Merge shapes of constituencies into state-level shapes
bland_shape <- wk_topo %>%
inner_join(dat_winneronly_grid, by = c("id" = "wkr")) %>%
group_by(land) %>%
summarize(geometry = st_union(geometry))
df_constituencies_highlight_hex <- wk_topo %>%
filter(id %in% constituencies_to_highlight) %>%
mutate(geometry = st_make_valid(geometry) %>%
st_centroid(),
lon = map(geometry, 1),
lat = map(geometry, 2),
name_short = str_extract(name, "[a-zA-ZäöüÄÖÜ]+"))
g <- dat_winneronly_grid %>%
inner_join(wk_topo, by = c("wkr" = "id")) %>%
ggplot(aes(geometry = geometry)) +
geom_sf(aes(fill = outcome_agg, col = outcome_agg, alpha = diff),
size = 0.1, # col = "grey80"
) +
geom_sf_text(aes(label = id),
size = 2.5, family = "Roboto Mono") +
geom_sf(data = bland_shape,
aes(geometry = geometry,
group = land),
fill = NA, col = "grey96",
size = 2, show.legend = FALSE) +
geom_sf(aes(col = outcome_agg),
size = 0.1, fill = "transparent"
) +
# geom_sf_label(data = df_constituencies_highlight_hex,
# aes(lon, lat, label = name_short),
# col = "grey99",
# fill = "grey10", alpha = 0.4, family = "Roboto",
# label.size = 0,
# fontface = "bold", size = 6,
# hjust = 0.5) +
#scale_x_continuous(limits = c(NA, )) +
scale_y_continuous(expand = c(.01, .01)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 0.25, alpha = .5))) +
theme(legend.position = c(.08, .15),
legend.key.size = unit(5, "mm"))
## Deutsche Version
g + labs(title = title_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.",
caption = glue("{caption_de}\nTilegram-Geometrie: pitchinteractiveinc.github.io"))
ggsave(here::here("plots", "hexagon_map_diff_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.",
caption = glue("{caption_en}\nTilegram-Geometrie: pitchinteractiveinc.github.io")) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "hexagon_map_diff_en.pdf"), width = 10, height = 13, device = cairo_pdf)
g <- dat_winneronly_grid %>%
inner_join(wk_topo, by = c("wkr" = "id")) %>%
ggplot(aes(geometry = geometry)) +
geom_sf(aes(fill = outcome_agg, col = outcome_agg, alpha = t),
size = 0.1, # col = "grey80"
) +
geom_sf_text(aes(label = id),
size = 2.5, family = "Roboto Mono") +
geom_sf(data = bland_shape,
aes(geometry = geometry,
group = land),
fill = NA, col = "grey96",
size = 2, show.legend = FALSE) +
geom_sf(aes(col = outcome_agg),
size = 0.1, fill = "transparent"
) +
# geom_sf_label(data = df_constituencies_highlight_hex,
# aes(lon, lat, label = name_short),
# col = "grey99",
# fill = "grey10", alpha = 0.4, family = "Roboto",
# label.size = 0,
# fontface = "bold", size = 6,
# hjust = 0.5) +
#scale_x_continuous(limits = c(NA, )) +
scale_y_continuous(expand = c(.01, .01)) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")), name = NULL) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "transparent")), name = NULL) +
scale_alpha(range = c(0, .86), guide = "none") +
guides(fill = guide_legend(override.aes = list(size = 0.25, alpha = .5))) +
theme(legend.position = c(.08, .15),
legend.key.size = unit(5, "mm"))
## Deutsche Version
g + labs(title = title_de,
subtitle = "Je intensiver die Färbung, desto größer ist der vorhergesagte Vorsprung.",
caption = glue("{caption_de}\nTilegram-Geometrie: pitchinteractiveinc.github.io"))
ggsave(here::here("plots", "hexagon_map_t_test_de.pdf"), width = 10, height = 13, device = cairo_pdf)
## Englische Version
g + labs(title = title_en,
subtitle = "The more intense the coloring of the dots, the greater the predicted lead.",
caption = glue("{caption_en}\nTilegram-Geometrie: pitchinteractiveinc.github.io")) +
scale_color_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en) +
scale_fill_manual(values = c(party_colors, c("Kopf-an-Kopf" = "grey85")),
name = NULL, labels = parties_en)
Scale for 'colour' is already present. Adding another scale for
'colour', which will replace the existing scale.Scale for 'fill' is already present. Adding another scale for
'fill', which will replace the existing scale.
ggsave(here::here("plots", "hexagon_map_t_test_en.pdf"), width = 10, height = 13, device = cairo_pdf)
pdfs <- list.files(here::here(), pattern = "*.pdf", recursive = TRUE)
for(pdf in pdfs) {
pdf_convert(pdf = glue::glue("{here::here()}/{pdf}"),
filenames = glue::glue("{here::here()}/{str_remove(pdf, '.pdf')}.png"),
format = "png", dpi = 500)
}
Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de_v2.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_de_v2.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_diff_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en_v2.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_en_v2.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/bubble_map_t_test_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_laender_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_laender_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_laender_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_laender_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_de_v2.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_de_v2.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_diff_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/grid_map_en_v2.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/grid_map_en_v2.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_diff_en.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_de.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_de.png... done!Warning in sprintf(filenames, pages, format): 2 arguments not used
by format 'C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/
2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_en.png'Converting page 1 to C:/Users/DataVizard/Google Drive/Work/DataViz/Personal/2021_Bundestagswahl/btw_tilemap/plots/hexagon_map_t_test_en.png... done!Session Info
Sys.time()
[1] "2021-09-25 21:14:18 CEST"R version 4.1.0 (2021-05-18)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19043)
Matrix products: default
locale:
[1] LC_COLLATE=German_Germany.1252 LC_CTYPE=German_Germany.1252
[3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C
[5] LC_TIME=German_Germany.1252
system code page: 65001
attached base packages:
[1] stats graphics grDevices utils datasets methods
[7] base
other attached packages:
[1] ggiraph_0.7.10 pdftools_3.0.1 sf_1.0-1
[4] labelled_2.8.0 gsheet_0.4.5 colorspace_2.0-2
[7] glue_1.4.2 here_1.0.1 forcats_0.5.1
[10] stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
[13] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2
[16] ggplot2_3.3.5 tidyverse_1.3.1
loaded via a namespace (and not attached):
[1] fs_1.5.0 lubridate_1.7.10 httr_1.4.2
[4] rprojroot_2.0.2 ggsci_2.9 tools_4.1.0
[7] backports_1.2.1 bslib_0.2.5.1 utf8_1.2.1
[10] R6_2.5.0 KernSmooth_2.23-20 lazyeval_0.2.2
[13] rgeos_0.5-5 DBI_1.1.1 sp_1.4-5
[16] withr_2.4.2 tidyselect_1.1.1 downlit_0.2.1
[19] curl_4.3.2 compiler_4.1.0 textshaping_0.3.5
[22] cli_3.0.0 rvest_1.0.0 pacman_0.5.1
[25] geojsonsf_2.0.1 xml2_1.3.2 labeling_0.4.2
[28] sass_0.4.0 scales_1.1.1 classInt_0.4-3
[31] proxy_0.4-26 askpass_1.1 systemfonts_1.0.2
[34] digest_0.6.27 foreign_0.8-81 rmarkdown_2.9
[37] pkgconfig_2.0.3 htmltools_0.5.1.1 dbplyr_2.1.1
[40] highr_0.9 htmlwidgets_1.5.3 rlang_0.4.11
[43] readxl_1.3.1 httpcode_0.3.0 rstudioapi_0.13
[46] jquerylib_0.1.4 generics_0.1.0 farver_2.1.0
[49] jsonlite_1.7.2 distill_1.2 magrittr_2.0.1
[52] Rcpp_1.0.7 munsell_0.5.0 fansi_0.5.0
[55] lifecycle_1.0.0 stringi_1.7.3 yaml_2.2.1
[58] jqr_1.2.1 maptools_1.1-1 grid_4.1.0
[61] geojsonio_0.9.4 crayon_1.4.1 lattice_0.20-44
[64] haven_2.4.1 geojson_0.3.4 hms_1.1.0
[67] knitr_1.33 pillar_1.6.1 uuid_0.1-4
[70] crul_1.1.0 reprex_2.0.0 evaluate_0.14
[73] V8_3.4.2 qpdf_1.1 modelr_0.1.8
[76] vctrs_0.3.8 cellranger_1.1.0 gtable_0.3.0
[79] assertthat_0.2.1 xfun_0.24 broom_0.7.8
[82] e1071_1.7-7 ragg_1.1.3 class_7.3-19
[85] units_0.7-2 ellipsis_0.3.2